home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH2 / SRC / GETBITS.FRM < prev    next >
Text File  |  1997-01-08  |  15KB  |  539 lines
  1. VERSION 4.00
  2. Begin VB.Form BitmapForm 
  3.    Caption         =   "GetBitmapBits"
  4.    ClientHeight    =   2100
  5.    ClientLeft      =   2280
  6.    ClientTop       =   1815
  7.    ClientWidth     =   3180
  8.    Height          =   2790
  9.    Left            =   2220
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   2100
  12.    ScaleWidth      =   3180
  13.    Top             =   1185
  14.    Width           =   3300
  15.    Begin VB.PictureBox Pict3 
  16.       AutoRedraw      =   -1  'True
  17.       AutoSize        =   -1  'True
  18.       Height          =   1020
  19.       Left            =   2160
  20.       Picture         =   "GETBITS.frx":0000
  21.       ScaleHeight     =   64
  22.       ScaleMode       =   3  'Pixel
  23.       ScaleWidth      =   64
  24.       TabIndex        =   8
  25.       Top             =   240
  26.       Width           =   1020
  27.    End
  28.    Begin VB.PictureBox Pict2 
  29.       AutoRedraw      =   -1  'True
  30.       AutoSize        =   -1  'True
  31.       Height          =   1020
  32.       Left            =   1080
  33.       Picture         =   "GETBITS.frx":1092
  34.       ScaleHeight     =   64
  35.       ScaleMode       =   3  'Pixel
  36.       ScaleWidth      =   64
  37.       TabIndex        =   7
  38.       Top             =   240
  39.       Width           =   1020
  40.    End
  41.    Begin VB.PictureBox Pict1 
  42.       AutoRedraw      =   -1  'True
  43.       AutoSize        =   -1  'True
  44.       Height          =   1020
  45.       Left            =   0
  46.       Picture         =   "GETBITS.frx":2124
  47.       ScaleHeight     =   64
  48.       ScaleMode       =   3  'Pixel
  49.       ScaleWidth      =   64
  50.       TabIndex        =   6
  51.       Top             =   240
  52.       Width           =   1020
  53.    End
  54.    Begin VB.CommandButton CmdColors 
  55.       Caption         =   "Colors"
  56.       Height          =   375
  57.       Left            =   2355
  58.       TabIndex        =   5
  59.       Top             =   1680
  60.       Width           =   615
  61.    End
  62.    Begin VB.CommandButton CmdCheck 
  63.       Caption         =   "Check"
  64.       Height          =   375
  65.       Left            =   1635
  66.       TabIndex        =   4
  67.       Top             =   1680
  68.       Width           =   615
  69.    End
  70.    Begin VB.CommandButton CmdWave 
  71.       Caption         =   "Wave"
  72.       Height          =   375
  73.       Left            =   915
  74.       TabIndex        =   3
  75.       Top             =   1680
  76.       Width           =   615
  77.    End
  78.    Begin VB.CommandButton CmdBlank 
  79.       Caption         =   "Blank"
  80.       Height          =   375
  81.       Left            =   195
  82.       TabIndex        =   1
  83.       Top             =   1680
  84.       Width           =   615
  85.    End
  86.    Begin VB.PictureBox Original 
  87.       AutoRedraw      =   -1  'True
  88.       AutoSize        =   -1  'True
  89.       Height          =   1020
  90.       Left            =   3000
  91.       Picture         =   "GETBITS.frx":31B6
  92.       ScaleHeight     =   64
  93.       ScaleMode       =   3  'Pixel
  94.       ScaleWidth      =   64
  95.       TabIndex        =   0
  96.       Top             =   1680
  97.       Visible         =   0   'False
  98.       Width           =   1020
  99.    End
  100.    Begin VB.Label Label1 
  101.       Alignment       =   2  'Center
  102.       Caption         =   "Line"
  103.       Height          =   255
  104.       Index           =   2
  105.       Left            =   2160
  106.       TabIndex        =   13
  107.       Top             =   0
  108.       Width           =   975
  109.    End
  110.    Begin VB.Label Label1 
  111.       Alignment       =   2  'Center
  112.       Caption         =   "GetBitmapBits"
  113.       Height          =   255
  114.       Index           =   1
  115.       Left            =   1080
  116.       TabIndex        =   12
  117.       Top             =   0
  118.       Width           =   975
  119.    End
  120.    Begin VB.Label Label1 
  121.       Alignment       =   2  'Center
  122.       Caption         =   "Line/Refresh"
  123.       Height          =   255
  124.       Index           =   0
  125.       Left            =   0
  126.       TabIndex        =   11
  127.       Top             =   0
  128.       Width           =   975
  129.    End
  130.    Begin VB.Label Time2 
  131.       BorderStyle     =   1  'Fixed Single
  132.       Height          =   255
  133.       Left            =   1080
  134.       TabIndex        =   10
  135.       Top             =   1320
  136.       Width           =   1020
  137.    End
  138.    Begin VB.Label Time1 
  139.       BorderStyle     =   1  'Fixed Single
  140.       Height          =   255
  141.       Left            =   0
  142.       TabIndex        =   9
  143.       Top             =   1320
  144.       Width           =   1020
  145.    End
  146.    Begin VB.Label Time3 
  147.       BorderStyle     =   1  'Fixed Single
  148.       Height          =   255
  149.       Left            =   2160
  150.       TabIndex        =   2
  151.       Top             =   1320
  152.       Width           =   1020
  153.    End
  154.    Begin VB.Menu mnuFile 
  155.       Caption         =   "&File"
  156.       Begin VB.Menu mnuFileExit 
  157.          Caption         =   "E&xit"
  158.       End
  159.    End
  160. End
  161. Attribute VB_Name = "BitmapForm"
  162. Attribute VB_Creatable = False
  163. Attribute VB_Exposed = False
  164. Option Explicit
  165.  
  166. Private Sub CmdWave_Click()
  167. Const AMP = 3
  168. Const PER = 5
  169. Dim start_time As Single
  170. Dim stop_time As Single
  171.  
  172. Dim hbm As Integer
  173. Dim bm As BITMAP
  174. Dim status As Integer
  175. Dim bytes() As Byte
  176. Dim i As Integer
  177. Dim j As Integer
  178. Dim k As Integer
  179. Dim wid As Integer
  180. Dim hgt As Integer
  181.  
  182.     CmdBlank.Enabled = False
  183.     CmdWave.Enabled = False
  184.     CmdCheck.Enabled = False
  185.     CmdColors.Enabled = False
  186.     Time1.Caption = ""
  187.     Time2.Caption = ""
  188.     Time3.Caption = ""
  189.     Pict1.Picture = Original.Image
  190.     Pict2.Picture = Original.Image
  191.     Pict3.Picture = Original.Image
  192.     MousePointer = vbHourglass
  193.     Refresh
  194.     
  195.     ' ***************************************
  196.     ' Wave picture 1 using PSet with refresh.
  197.     ' ***************************************
  198.     start_time = Timer()
  199.     For i = AMP To Pict1.ScaleHeight - AMP Step 3
  200.         For j = 0 To Pict1.ScaleWidth - 1
  201.             k = AMP * Cos(j / PER)
  202.             Pict1.PSet (j, i + k), vbBlack
  203.         Next j
  204.         Pict1.Refresh
  205.     Next i
  206.     stop_time = Timer()
  207.     Time1.Caption = Format$(stop_time - start_time, "0.00000")
  208.     Time1.Refresh
  209.  
  210.     ' *****************************
  211.     ' Wave picture 2 using SetBits.
  212.     ' *****************************
  213.     start_time = Timer()
  214.     hbm = Pict2.Image
  215.  
  216.     ' See how big it is.
  217.     status = GetObject(hbm, BITMAP_SIZE, bm)
  218.  
  219.     ' Get the bits.
  220.     wid = bm.bmWidthBytes
  221.     hgt = bm.bmHeight
  222.     ReDim bytes(1 To wid, 1 To hgt)
  223.     status = GetBitmapBits(hbm, wid * hgt, bytes(1, 1))
  224.  
  225.     ' Make the wave.
  226.     For i = AMP + 1 To hgt - AMP Step 3
  227.         For j = 1 To wid
  228.             k = AMP * Cos(j / PER)
  229.             bytes(j, i + k) = 0
  230.         Next j
  231.     Next i
  232.  
  233.     ' Set the bits.
  234.     status = SetBitmapBits(hbm, wid * hgt, bytes(1, 1))
  235.  
  236.     Pict2.Refresh
  237.     stop_time = Timer()
  238.     Time2.Caption = Format$(stop_time - start_time, "0.00000")
  239.     Time2.Refresh
  240.     
  241.     ' ******************************************
  242.     ' Wave picture 3 using PSet without refresh.
  243.     ' ******************************************
  244.     start_time = Timer()
  245.     For i = AMP To Pict3.ScaleHeight - AMP Step 3
  246.         For j = 0 To Pict3.ScaleWidth - 1
  247.             k = AMP * Cos(j / PER)
  248.             Pict3.PSet (j, i + k), vbBlack
  249.         Next j
  250.     Next i
  251.     Pict3.Refresh
  252.     stop_time = Timer()
  253.     Time3.Caption = Format$(stop_time - start_time, "0.00000")
  254.  
  255.     CmdBlank.Enabled = True
  256.     CmdWave.Enabled = True
  257.     CmdCheck.Enabled = True
  258.     CmdColors.Enabled = True
  259.     MousePointer = vbDefault
  260. End Sub
  261.  
  262. Private Sub CmdCheck_Click()
  263. Dim start_time As Single
  264. Dim stop_time As Single
  265.  
  266. Dim hbm As Integer
  267. Dim bm As BITMAP
  268. Dim status As Integer
  269. Dim bytes() As Byte
  270. Dim i As Integer
  271. Dim j As Integer
  272. Dim wid As Integer
  273. Dim hgt As Integer
  274.  
  275.     CmdBlank.Enabled = False
  276.     CmdWave.Enabled = False
  277.     CmdCheck.Enabled = False
  278.     CmdColors.Enabled = False
  279.     Time1.Caption = ""
  280.     Time2.Caption = ""
  281.     Time3.Caption = ""
  282.     Pict1.Picture = Original.Image
  283.     Pict2.Picture = Original.Image
  284.     Pict3.Picture = Original.Image
  285.     MousePointer = vbHourglass
  286.     Refresh
  287.     
  288.     ' ****************************************
  289.     ' Check picture 1 using PSet with refresh.
  290.     ' ****************************************
  291.     start_time = Timer()
  292.     wid = Pict1.ScaleWidth - 1
  293.     hgt = Pict1.ScaleHeight - 1
  294.     For i = 0 To hgt Step 2
  295.         Pict1.Line (0, i)-(wid, i)
  296.         Pict1.Refresh
  297.     Next i
  298.     For i = 0 To wid Step 2
  299.         Pict1.Line (i, 0)-(i, hgt)
  300.         Pict1.Refresh
  301.     Next i
  302.     stop_time = Timer()
  303.     Time1.Caption = Format$(stop_time - start_time, "0.00000")
  304.     Time1.Refresh
  305.     
  306.     ' ******************************
  307.     ' Check picture 2 using SetBits.
  308.     ' ******************************
  309.     start_time = Timer()
  310.     hbm = Pict2.Image
  311.  
  312.     ' See how big it is.
  313.     status = GetObject(hbm, BITMAP_SIZE, bm)
  314.  
  315.     ' Get the bits.
  316.     wid = bm.bmWidthBytes
  317.     hgt = bm.bmHeight
  318.     ReDim bytes(1 To wid, 1 To hgt)
  319.     status = GetBitmapBits(hbm, wid * hgt, bytes(1, 1))
  320.  
  321.     ' Check it.
  322.     For i = 1 To hgt Step 2
  323.         For j = 1 To wid
  324.             bytes(j, i) = 0
  325.         Next j
  326.     Next i
  327.     For i = 1 To wid Step 2
  328.         For j = 1 To hgt
  329.             bytes(i, j) = 0
  330.         Next j
  331.     Next i
  332.  
  333.     ' Set the bits.
  334.     status = SetBitmapBits(hbm, wid * hgt, bytes(1, 1))
  335.  
  336.     Pict2.Refresh
  337.     stop_time = Timer()
  338.     Time2.Caption = Format$(stop_time - start_time, "0.00000")
  339.     Time2.Refresh
  340.     
  341.     ' ******************************************
  342.     ' Wave picture 3 using PSet without refresh.
  343.     ' ******************************************
  344.     start_time = Timer()
  345.     wid = Pict3.ScaleWidth - 1
  346.     hgt = Pict3.ScaleHeight - 1
  347.     For i = 0 To hgt Step 2
  348.         Pict3.Line (0, i)-(wid, i)
  349.     Next i
  350.     For i = 0 To wid Step 2
  351.         Pict3.Line (i, 0)-(i, hgt)
  352.     Next i
  353.     Pict3.Refresh
  354.     stop_time = Timer()
  355.     Time3.Caption = Format$(stop_time - start_time, "0.00000")
  356.  
  357.     CmdBlank.Enabled = True
  358.     CmdWave.Enabled = True
  359.     CmdCheck.Enabled = True
  360.     CmdColors.Enabled = True
  361.     MousePointer = vbDefault
  362. End Sub
  363.  
  364. Sub CmdColors_Click()
  365. Static running As Boolean
  366.  
  367. Dim hbm As Integer
  368. Dim bm As BITMAP
  369. Dim status As Integer
  370. Dim bytes() As Byte
  371. Dim i As Integer
  372. Dim j As Integer
  373. Dim wid As Integer
  374. Dim hgt As Integer
  375. Dim color As Integer
  376.  
  377.     If running Then
  378.         running = False
  379.         CmdColors.Enabled = False
  380.         Exit Sub
  381.     End If
  382.     CmdBlank.Enabled = False
  383.     CmdWave.Enabled = False
  384.     CmdCheck.Enabled = False
  385.     CmdColors.Caption = "Stop"
  386.     running = True
  387.     
  388.     Time1.Caption = ""
  389.     Time2.Caption = ""
  390.     Time3.Caption = ""
  391.     Pict1.Picture = Original.Image
  392.     Pict2.Picture = Original.Image
  393.     Pict3.Picture = Original.Image
  394.     MousePointer = vbHourglass
  395.     Refresh
  396.         
  397.     ' Get the bits.
  398.     hbm = Pict2.Image
  399.     
  400.     status = GetObject(hbm, BITMAP_SIZE, bm)
  401.     wid = bm.bmWidthBytes
  402.     hgt = bm.bmHeight
  403.     ReDim bytes(1 To wid, 1 To hgt)
  404.     status = GetBitmapBits(hbm, wid * hgt, bytes(1, 1))
  405.     wid = bm.bmWidthBytes
  406.  
  407.     ' Display the colors in the palette.
  408.     For color = 0 To 255
  409.         If Not running Then Exit For
  410.         Time2.Caption = Format$(color)
  411.     
  412.         For i = 1 To wid
  413.             For j = 1 To hgt
  414.                 If bytes(i, j) <> 255 Then _
  415.                    bytes(i, j) = color
  416.             Next j
  417.         Next i
  418.     
  419.         status = SetBitmapBits(hbm, wid * hgt, bytes(1, 1))
  420.         Pict2.Refresh
  421.         
  422.         ' Waste a little time. You may need to
  423.         ' adjust this for your computer.
  424.         For i = 1 To 1000
  425.             DoEvents
  426.         Next i
  427.     Next color
  428.  
  429.     running = False
  430.     Time2.Caption = ""
  431.     Pict2.Picture = Original.Image
  432.     
  433.     CmdColors.Caption = "Colors"
  434.     CmdBlank.Enabled = True
  435.     CmdWave.Enabled = True
  436.     CmdCheck.Enabled = True
  437.     CmdColors.Enabled = True
  438.     MousePointer = vbDefault
  439. End Sub
  440.  
  441. Private Sub CmdBlank_Click()
  442. Dim start_time As Single
  443. Dim stop_time As Single
  444.  
  445. Dim hbm As Integer
  446. Dim bm As BITMAP
  447. Dim status As Integer
  448. Dim bytes() As Byte
  449. Dim i As Integer
  450. Dim j As Integer
  451. Dim wid As Integer
  452. Dim hgt As Integer
  453.     
  454.     CmdBlank.Enabled = False
  455.     CmdWave.Enabled = False
  456.     CmdCheck.Enabled = False
  457.     CmdColors.Enabled = False
  458.     Time1.Caption = ""
  459.     Time2.Caption = ""
  460.     Time3.Caption = ""
  461.     Pict1.Picture = Original.Image
  462.     Pict2.Picture = Original.Image
  463.     Pict3.Picture = Original.Image
  464.     MousePointer = vbHourglass
  465.     Refresh
  466.     
  467.     ' ****************************************
  468.     ' Blank picture 1 using PSet with refresh.
  469.     ' ****************************************
  470.     start_time = Timer()
  471.     For i = 0 To Pict1.ScaleHeight - 1
  472.         For j = 0 To Pict1.ScaleWidth - 1
  473.             Pict1.PSet (j, i), vbBlack
  474.         Next j
  475.         Pict1.Refresh
  476.     Next i
  477.     stop_time = Timer()
  478.     Time1.Caption = Format$(stop_time - start_time, "0.00000")
  479.     Time1.Refresh
  480.     
  481.     ' ******************************
  482.     ' Blank picture 2 using SetBits.
  483.     ' ******************************
  484.     start_time = Timer()
  485.     hbm = Pict2.Image
  486.  
  487.     ' See how big it is.
  488.     status = GetObject(hbm, BITMAP_SIZE, bm)
  489.  
  490.     ' Get the bits.
  491.     wid = bm.bmWidthBytes
  492.     hgt = bm.bmHeight
  493.     ReDim bytes(1 To wid, 1 To hgt)
  494.     status = GetBitmapBits(hbm, wid * hgt, bytes(1, 1))
  495.     
  496.     ' Set all bits to color 0.
  497.     For i = 1 To hgt
  498.         For j = 1 To wid
  499.             bytes(i, j) = 0
  500.         Next j
  501.     Next i
  502.  
  503.     ' Set the bits.
  504.     status = SetBitmapBits(hbm, wid * hgt, bytes(1, 1))
  505.  
  506.     Pict2.Refresh
  507.     stop_time = Timer()
  508.     Time2.Caption = Format$(stop_time - start_time, "0.00000")
  509.     Time2.Refresh
  510.     
  511.     ' *******************************************
  512.     ' Blank picture 3 using PSet without refresh.
  513.     ' *******************************************
  514.     start_time = Timer()
  515.     For i = 0 To Pict3.ScaleWidth - 1
  516.         For j = 0 To Pict3.ScaleHeight - 1
  517.             Pict3.PSet (i, j), vbBlack
  518.         Next j
  519.     Next i
  520.     Pict3.Refresh
  521.     stop_time = Timer()
  522.     Time3.Caption = Format$(stop_time - start_time, "0.00000")
  523.     
  524.     CmdBlank.Enabled = True
  525.     CmdWave.Enabled = True
  526.     CmdCheck.Enabled = True
  527.     CmdColors.Enabled = True
  528.     MousePointer = vbDefault
  529. End Sub
  530.  
  531. Private Sub Form_Unload(Cancel As Integer)
  532.     End
  533. End Sub
  534.  
  535. Private Sub mnuFileExit_Click()
  536.     Unload Me
  537. End Sub
  538.  
  539.